home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Precision Software Appli…tions Silver Collection 4
/
Precision Software Applications Silver Collection Volume 4 (1993).iso
/
new
/
cuaclip.arj
/
EX5.PRG
< prev
next >
Wrap
Text File
|
1993-06-01
|
10KB
|
446 lines
/*********************************************************************
EX5.PRG - CUA-Clip Library examples.
This file contains sample code combining STDBrowse, GETs and
the Event system in one module.
Author: Dave Rooney
Date : Feb. 23, 1993
*********************************************************************/
#include "Demo.CH"
//
// Example 5 - STDBrowse with a menu.
//
FUNCTION TheWholeThing
LOCAL cScreen, ; // Screen on entry
bInterrupt, ; // Interrupt code block on entry
aFields, ; // Fields array for the browse
aMenu, ; // Menu array for the browse
cColor, ; // Colour string for the browse
cTitle, ; // Title text
i // Loop counter
//
// Ensure Printer.DBF/.NTX are there. If not, make 'em!
//
IF !( FILE( "Printer.DBF" ) .AND. FILE( "Printer.NTX" ))
_BuildPrinter()
ENDIF
//
// Open the printer file.
//
IF DBNetUse( .T., "DBFNTX", "Printer" )
DBSETINDEX( "Printer" )
ELSE
RETURN NIL
ENDIF
cScreen := SAVESCREEN()
//
// Set an interrupt function to be called during wait states,
// i.e. InterruptKey(). Note that we're saving the current
// interrupt code block which we'll restore later.
//
bInterrupt := SetInterrupt( {|| MyInterrupt() } )
//
// Build the menu array...
//
aMenu := {;
{ "~Add", {|| AddModPrinter(.T.) } }, ;
{ "~Modify", {|| AddModPrinter(.F.) } }, ;
{ "~Delete", {|| DeletePrinter() } }, ;
{ "E~xit", {|oB| oB:cargo[ B_LMORE ] := .F. } } }
//
// Fields array for the STDBrowse...
//
aFields := { ;
{ "Printer Name", {|| FIELD->PrnName } }, ;
{ "Port", {|| PADC( FIELD->Port, 6 ) } }, ;
{ "PostScript", {|| PADC( IF( FIELD->PostScript, "Yes", "No" ), 10 ) } } }
cColor := "B/BG,GR+/BG,W+/BG,W+/R"
cTitle := " Printer File "
//
// Browse it!!
//
STDBrowse( 5, 3, MAXROW() - 5, MAXCOL() - 3, aFields, cTitle,, ;
cColor, .F., aMenu )
//
// Close the printer file...
//
DBNetClose( "Printer" )
//
// Reset the interrupt code block...
//
SetInterrupt( bInterrupt )
RESTSCREEN(,,,, cScreen )
RETURN NIL
//
// That's all folks!
//
/*******************************************************************
FUNCTION AddModPrinter
This function is used to add a new printer to the list, or
modify an existing one.
Parameters: lAddFlag - .T. if adding, .F. if modifying.
Returns: .T.
*******************************************************************/
STATIC FUNCTION AddModPrinter ( lAddFlag )
LOCAL cScreen, ; // Screen behind the dialog box
cOldColor, ; // Colour on entry
GetList, ; // Local GetList array
cPrinter, ; // Name of the printer
cPort, ; // Printer port selected
lPostScript, ; // .T. if the printer is PostScript
aPrinters, ; // DBLIST array for the Printer lookup
aPorts, ; // Radio button array for the Printer port
lProceed // .T. if proceeding with the Add/Modify
//
// Initialize the variables...
//
cOldColor := SETCOLOR()
GetList := {}
lProceed := .F.
//
// Radio button array for the printer port...
//
aPorts := { { { "LPT1", "LPT1" }, { "LPT2", "LPT2" }, { "LPT3", "LPT3" } } }
IF lAddFlag
cPrinter := SPACE(30)
cPort := "LPT1"
lPostScript := .F.
ELSE
IF RLOCK()
cPrinter := Printer->PrnName
cPort := Printer->Port
lPostScript := Printer->PostScript
ELSE
TONE( 250, 1 )
ALERT( "Could not lock record!" )
RETURN .T.
ENDIF
ENDIF
//
// Display the dialog box
//
cScreen := ShadowBox( 2, 12, 13, 68, 2, "GR+/B" )
SETCOLOR( "W+/B" )
@ 2,15 SAY "[ CUA-Clip Interface Library - GET System Examples ]"
SETCOLOR( "BG+/B" )
@ 4,15 SAY " Name:"
@ 6,15 SAY " Port:"
@ 8,15 SAY "PostScript:"
//
// Standard GET with a database list. Note the use of Monitor() to
// refresh all of the GETs after a printer name has been entered.
// This will change the colour of the radio buttons and check box
// from dimmed to normal.
//
@ 4,27 GET cPrinter ;
VALID V_Printer( cPrinter, lAddFlag ) ;
COLOR "W+/N, W+/R, W/N" ;
MESSAGE "Enter the name of the printer"
//
// Radio buttons - nothing too fancy here!
//
@ 6,27 GET cPort USING RADIO WITH aPorts ;
WHEN !EMPTY( cPrinter ) ;
VALID cPort $ "LPT1|LPT2|LPT3" ;
COLOR "W+/B, W+/R, W/B" ;
MESSAGE "Select the port for the printer"
//
// Check box - piece of cake!
//
@ 8,27 GET lPostScript USING CHECK ;
WHEN !EMPTY( cPrinter ) ;
COLOR "W+/B, W+/R, W/B" ;
MESSAGE "Is it a PostScript printer?"
//
// Push buttons - code 'em in your sleep! Note that the ACTION expression
// returns a logical value: .T. means end the READ, .F. means continue.
//
@ 10,25 BUTTON " ~Save " ;
WHEN Updated() ;
ACTION ( lProceed := ( ValidGets() == 0 ) ) ;
COLOR "W+/BG, W+/R, N/BG, R/BG, N/BG"
@ 10,43 BUTTON " ~Abort " ;
ACTION !( lProceed := .F. ) ;
COLOR "W+/BG, W+/R, N/BG, R/BG, N/BG"
READ
//
// Is the user selected 'Save', write the changes to the file.
//
IF lProceed
IF lAddFlag
//
// Add a new record...
//
DBAPPEND()
ENDIF
REPLACE Printer->PrnName WITH cPrinter
REPLACE Printer->Port WITH cPort
REPLACE Printer->PostScript WITH lPostScript
//
// Unlock the record & flush the buffers to disk.
//
DBUNLOCK()
DBCOMMIT()
ENDIF
//
// Get rid of the dialog box...
//
KillBox( cScreen )
SETCOLOR( cOldColor )
RETURN .T.
//
// EOP: AddModPrinter
//
/*******************************************************************
FUNCTION DeletePrinter
This function is used to delete a printer from the list.
Parameters: None.
Returns: .T.
*******************************************************************/
STATIC FUNCTION DeletePrinter
LOCAL cScreen, ; // Screen behind the dialog box
cOldColor, ; // Colour on entry
GetList, ; // Local GetList array
cPrinter, ; // Name of the printer
lProceed // .T. if proceeding with the Add/Modify
//
// Initialize the variables...
//
cOldColor := SETCOLOR()
GetList := {}
cPrinter := ALLTRIM( Printer->PrnName )
lProceed := .F.
//
// Display the dialog box
//
cScreen := ShadowBox( 5, 12, 14, 68, 2, "GR+/B" )
SETCOLOR( "W+/B" )
@ 7,14 SAY "Delete this printer from the file?"
SETCOLOR( "GR+/B" )
@ 9,14 SAY cPrinter
@ 11,25 BUTTON " Delete " ;
ACTION ( lProceed := .T. ) ;
COLOR "W+/BG, W+/R, N/BG, R/BG, N/BG"
@ 11,43 BUTTON " Cancel " ;
ACTION !( lProceed := .F. ) ;
COLOR "W+/BG, W+/R, N/BG, R/BG, N/BG"
READ
//
// Is the user selected 'Delete', turf that record!
//
IF lProceed
IF RLOCK()
//
// Mark the record for deletion!
//
DBDELETE()
//
// Unlock the record & flush the buffers to disk.
//
DBUNLOCK()
DBCOMMIT()
ELSE
TONE( 250, 1 )
ALERT( "Could not lock record!" )
ENDIF
ENDIF
//
// Get rid of the dialog box...
//
KillBox( cScreen )
SETCOLOR( cOldColor )
RETURN .T.
//
// EOP: DeletePrinter
//
/*******************************************************************
FUNCTION V_Printer
This function is used to validate the printer name entered.
If the user is adding a new printer, the function ensures that
the printer name has not already been used. If the user is modifying,
ensure that the name has not been used for another printer.
Parameters: cPrinter - The name of the printer to validate.
lAddFlag - .T. if adding, .F. if modifying.
Returns: .T. if valid, .F. otherwise.
*******************************************************************/
STATIC FUNCTION V_Printer ( cPrinter, lAddFlag )
LOCAL lRetCode, ; // Function's return code
nRecNo, ; // Record number on entry
x
lRetCode := .F. // I'm a pessimist!
nRecNo := RECNO()
IF lAddFlag
//
// Adding a printer, so simply check for an existing printer
// of the same name. If one is there, the name is invalid!
//
lRetCode := !DBSEEK( UPPER( cPrinter ), .F. )
ELSE
//
// Modifying is a bit different. If the printer name is found in
// the file, it could simply be the same record that we're
// modifying!! Soooo, compare the record number with that on
// entry. If they're different, then there's another printer
// with the same name - the entry is then invalid.
//
IF DBSEEK( UPPER( cPrinter ), .F. )
lRetCode := ( RECNO() == nRecNo ) // Is it the same record?
ELSE
lRetCode := .T.
ENDIF
ENDIF
IF !lRetCode
TONE( 250, 1 )
IF EMPTY( cPrinter )
ALERT( "You must enter a printer name!" )
ELSE
ALERT( "That printer already exists!" )
ENDIF
ENDIF
//
// Reset the record pointer.
//
DBGOTO( nRecNo )
RETURN lRetCode
//
// EOP: V_Printer
//
/*******************************************************************
FUNCTION MyInterrupt
This is our background function that will be called during the
InterruptKey wait state.
NOTE: You must remember that this function will be called many times!
As such its processing must be kept to a minimum. In this case
we will only redisplay the time if it has changed.
Parameters: None.
Returns: NIL
*******************************************************************/
STATIC FUNCTION MyInterrupt
STATIC cOldTime
LOCAL cOldColor, ; // Colour on entry
cCurTime, ; // Current time
nRow, nCol // Position on entry
IF cOldTime == NIL
cOldTime := TIME()
ENDIF
cCurTime := TIME()
IF !( cCurTime == cOldTime )
cOldColor := SETCOLOR( "W+/B" )
nRow := ROW()
nCol := COL()
@ 0,MAXCOL() - 9 SAY cCurTime
cOldTime := cCurTime
SETPOS( nRow, nCol )
SETCOLOR( cOldColor )
ENDIF
RETURN NIL
//
// EOP: MyInterrupt
//